home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SPADV.ZIP / INSTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-01  |  3.8 KB  |  157 lines
  1. uses Dos,Crt,Printer;
  2.  
  3. const
  4.   SAdir = '';
  5. type
  6.   Str80 = string [80];
  7.   TxtPtrTyp = ^TxtTyp;
  8.   TxtTyp = record
  9.              Line : Str80;
  10.              Last,Next : TxtPtrTyp;
  11.            end;
  12. var
  13.   Doc : text;
  14.   Start,Finish,TxtPtr,LinPtr,LastPtr : TxtPtrTyp;
  15.   Key,Key2 : char;
  16.   Ctr : byte;
  17.  
  18. type
  19.   OnOff = (On,Off);
  20.  
  21. procedure Cursor (CursorState:OnOff);
  22. var
  23.   Reg : Registers;
  24. begin
  25.   case CursorState of
  26.     On  : Reg.CX := $0607;    (* $06 start line, $07 end line *)
  27.     Off : Reg.CX := $FFFF;    (* $FFFF won't display cursor at all *)
  28.   end;
  29.   Reg.AX := $100;
  30.   Intr ($10,Reg);
  31. end;
  32.  
  33. type Name=string[255];
  34. function Exist(FileName:Name):boolean;
  35. var
  36.   fil:file;
  37. begin
  38.   Assign (Fil,FileName); {$I-}
  39.   Reset (Fil);           {$I+}
  40.   if IOresult<>0 then Exist := False
  41.   else begin
  42.     Close (Fil);
  43.     Exist:=(IOResult=0);
  44.   end;
  45. end;
  46.  
  47. procedure ReadDoc;
  48. begin
  49.   if not Exist ('SPADV.DOC') then begin
  50.     TextMode (Co80);
  51.     Writeln ('INSTR error :');
  52.     Writeln ('File SPADV.DOC not found !');
  53.     Halt;
  54.   end;
  55.   Assign (Doc,SAdir+'SPADV.DOC');
  56.   Reset (Doc);
  57.   Start := nil;
  58.   TxtPtr := nil;
  59.   repeat
  60.     if Start <> nil then LastPtr := TxtPtr;
  61.     New (TxtPtr);
  62.     Readln (Doc,TxtPtr^.Line);
  63.     if Start = nil then begin
  64.       Start := TxtPtr;
  65.       Start^.Last := nil;
  66.     end else begin
  67.       TxtPtr^.Last := LastPtr;
  68.       LastPtr^.Next := TxtPtr;
  69.     end;
  70.     TxtPtr^.Next := nil;
  71.   until Eof(Doc);
  72.   Close (Doc);
  73.   Finish := TxtPtr;
  74. end;
  75.  
  76. procedure WritePage (TxtPtr:TxtPtrTyp);
  77. begin
  78.   ClrScr;
  79.   repeat
  80.     Writeln (TxtPtr^.Line);
  81.     TxtPtr := TxtPtr^.Next;
  82.   until (WhereY=24) or (TxtPtr=nil);
  83. end;
  84.  
  85. procedure Print;
  86. var
  87.   TxtPtr : TxtPtrTyp;
  88. begin
  89.   TxtPtr := Start;
  90.   repeat
  91.     Writeln (Lst, TxtPtr^.Line);
  92.     TxtPtr := TxtPtr^.Next;
  93.   until TxtPtr = nil;
  94. end;
  95.  
  96. procedure ShowInstructions;
  97. begin
  98.   TxtPtr := Start;
  99.   WritePage (TxtPtr);
  100.   repeat
  101.     Key := UpCase(ReadKey); Key2 := #0;
  102.     if (Key=#0) and KeyPressed then begin
  103.       Key2:=ReadKey;
  104.       case Key2 of
  105.         'H' : if TxtPtr^.Last <> nil then begin
  106.                 TxtPtr := TxtPtr^.Last;
  107.                 GotoXY (1,23); ClrEol;
  108.                 GotoXY (1,1); InsLine;
  109.                 Writeln (TxtPtr^.Line);
  110.               end;
  111.         'P' : begin
  112.                 Ctr := 1; LinPtr := TxtPtr;
  113.                 repeat
  114.                   LinPtr := LinPtr^.Next;
  115.                   Inc(Ctr);
  116.                 until (Ctr=24) or (LinPtr=nil);
  117.                 if LinPtr <> nil then begin
  118.                   TxtPtr := TxtPtr^.Next;
  119.                   GotoXY (1,1); DelLine;
  120.                   GotoXY (1,23); Writeln (LinPtr^.Line);
  121.                 end;
  122.               end;
  123.         'I' : if TxtPtr <> Start then begin
  124.                 Ctr := 1; LinPtr := TxtPtr;
  125.                 repeat
  126.                   LinPtr := LinPtr^.Last;
  127.                   Inc(Ctr);
  128.                 until (Ctr=24) or (LinPtr^.Last=nil);
  129.                 TxtPtr := LinPtr;
  130.                 WritePage (TxtPtr);
  131.               end;
  132.         'Q' : if TxtPtr <> Finish then begin
  133.                 Ctr := 1; LinPtr := TxtPtr;
  134.                 repeat
  135.                   LinPtr := LinPtr^.Next;
  136.                   Inc(Ctr);
  137.                 until (Ctr=24) or (LinPtr^.Next=nil);
  138.                 TxtPtr := LinPtr;
  139.                 WritePage (TxtPtr);
  140.               end;
  141.       end;
  142.     end;
  143.     if Key='P' then Print;
  144.   until (Key=#27);
  145. end;
  146.  
  147. begin
  148.   ReadDoc;
  149.   Textmode (Co80);
  150.   Cursor (Off);
  151.   GotoXY (1,25); TextBackGround (Blue); TextColor (White);
  152.   Write ('SPACE ADVENTURE instructions           '#24', '#25', PgUp, PgDn, P to print, ESC to end');
  153.   Window (1,1,80,24); TextBackGround (LightGray); TextColor (Black);
  154.   ShowInstructions;
  155.   TextMode (Co80);
  156. end.
  157.